/*-------------------<-- Start of Description -->--------------------\
| Generate random variates from a permutation; |
|-----------------------------------------|
|--------------------------------------------------------------------|
|-------------------------|
| Argument Required: |
| seed - seed; default is the current system time; |
| var - the name of the output variable or output array name to |
| save the generated variates; |
| n - the size of the array to be generated; |
| init - this function is being used the 1st time in the current |
| data step or not? default is 1: declare an array for use;|
| otherwise: do not declare the array, since it has alreay |
| been declared earlier; |
|---------------------------|
|--------------------------------------------------------------------|
|---------------------------------|
| Example: |
| data one; |
do i=1 to 200; |
| %_ranperm(seed=1, var=x, n=7); |
| output; |
| end; |
| %_ranperm(seed=_ranperm0_, var=x, n=7, init=0); |
| output; |
| run;proc print data=one; run; |
| Usage: %_ranperm(seed=%sysfunc(datetime(), 15.), var=, n=, init=1);|
\----------------------------------*/
%macro _ranperm(seed=%sysfunc(datetime(), 15.), var=, n=, init=1,
temp=_ranperm0_);
/*--------------------------------------------\
| Copy Right: Duo Zhou; |
| Created: 3-22-2002 9:30pm; |
| Purpose: Generate random variates from a |
| permutation; |
\--------------------------------------------*/
%local i; %global _ranpermjobid;
%if (%quote(&_ranpermjobid) ne ) %then %let _ranpermjobid=%eval(&_ranpermjobid+1);
%else %let _ranpermjobid=0;
%if (%quote(&seed) eq) or (%quote(&var) eq) or (%quote(&n) eq) %then %do;
%if (%quote(&seed) eq) %then %do;
%put ==> Error: This is not a valid seed!;
%if (%length(&var)) %then %do; &var=.; %end;
%end;
%if (%quote(&var) eq) %then %do;
%put ==> Error: This function will need a valid array to save the generated random;
%put +++ variates!;
%if (%length(&var)) %then %do; &var=.; %end;
%end;
%if (%quote(&n) eq) %then %do;
%put ==> Error: I will save the generated random variates into the array "&var", so;
%put +++ please provide array dimension !;
%if (%length(&var)) %then %do; &var=.; %end;
%end;
%goto finish;
%end;
%else %do;
%if (not %sysfunc(rxmatch(%sysfunc(rxparse(_|.|$a|$A|$w)),&seed))) %then %do;
drop &temp;
retain &temp &seed;
%let seed=&temp;
%end;
%if (&init) or (%index(%quote(%upcase(&init)), T)) %then %do;
drop ranperm1 ranperm2 ranperm3;
array _ranperm(&n) _temporary_;
array &var(&n) &var.1 - &var.%left(&n);
%end;
do ranperm1=1 to &n;
_ranperm(ranperm1)=ranperm1;
end;
%_rantbl(seed=&seed, var=ranperm2, n=&n, init=&init);
ranperm1=&n;
&var(ranperm1)=_ranperm(ranperm2);
do ranperm3=ranperm2 to ranperm1-1;
_ranperm(ranperm3)=_ranperm(ranperm3+1);
end;
_ranperm(ranperm1)=0;
%do i=&n-1 %to 2 %by -1;
do until(ranperm1<&n);
%_rantbl(seed=&seed, var=ranperm2, n=&i, init=0);
ranperm1=&i;
&var(ranperm1)=_ranperm(ranperm2);
do ranperm3=ranperm2 to ranperm1-1;
_ranperm(ranperm3)=_ranperm(ranperm3+1);
end;
_ranperm(ranperm1)=0;
end;
%end;
&var(1)=_ranperm(1);
%end;
%finish:
%mend _ranperm;